home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / GFILE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  6.4 KB  |  255 lines
  1. { gfile.pas -- Demonstrate File dialogs }
  2.  
  3. program GFile;
  4.  
  5. {$R gfile.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, WinDOS, Strings, StdDlgs;
  8.  
  9. const
  10.  
  11.   id_Menu = 100;             { Menu resource ID }
  12.  
  13.   noFileStr = '[unnamed]';   { No file open window title }
  14.  
  15.   cm_FileOpen   = 101;       { File-menu command IDs }
  16.   cm_FileClose  = 102;
  17.   cm_FileSave   = 103;
  18.   cm_FileSaveAs = 104;
  19.   cm_FileExit   = 105;
  20.  
  21. type
  22.  
  23.   GFileApplication = object(TApplication)
  24.     procedure InitMainWindow; virtual;
  25.   end;
  26.  
  27.   PGFileWindow = ^GFileWindow;
  28.   GFileWindow = object(TWindow)
  29.     FileIsOpen, FileIsChanged: Boolean;
  30.     FileName: array[0 .. fsPathName] of Char;
  31.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  32.     procedure Error(S: String);
  33.     function OpenFile: Boolean;
  34.     function SaveFile: Boolean;
  35.     procedure DisableAll;
  36.     procedure EnableCommand(commandID: Integer);
  37.     procedure DisableCommand(commandID: Integer);
  38.     function CanClose: Boolean; virtual;
  39.     procedure FileOpen(var Msg: TMessage);
  40.       virtual cm_First + cm_FileOpen;
  41.     procedure FileClose(var Msg: TMessage);
  42.       virtual cm_First + cm_FileClose;
  43.     procedure FileSave(var Msg: TMessage);
  44.       virtual cm_First + cm_FileSave;
  45.     procedure FileSaveAs(var Msg: TMessage);
  46.       virtual cm_First + cm_FileSaveAs;
  47.     procedure FileExit(var Msg: TMessage);
  48.       virtual cm_First + cm_FileExit;
  49.     procedure WMLButtonDown(var Msg: TMessage);
  50.       virtual wm_First + wm_LButtonDown;
  51.   end;
  52.  
  53.  
  54. { GFileApplication }
  55.  
  56. {- Initialize GFileApplication object's window }
  57. procedure GFileApplication.InitMainWindow;
  58. begin
  59.   MainWindow := New(PGFileWindow, Init(nil, noFileStr))
  60. end;
  61.  
  62.  
  63. { GFileWindow }
  64.  
  65. {- Construct GFileWindow object }
  66. constructor GFileWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  67. begin
  68.   TWindow.Init(AParent, ATitle);
  69.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  70.   FileIsOpen := false;
  71.   FileIsChanged := false;
  72.   DisableAll;
  73.   EnableCommand(cm_FileOpen)
  74. end;
  75.  
  76. {- Disable all File-menu commands }
  77. procedure GFileWindow.DisableAll;
  78. begin
  79.   DisableCommand(cm_FileOpen);
  80.   DisableCommand(cm_FileClose);
  81.   DisableCommand(cm_FileSave);
  82.   DisableCommand(cm_FileSaveAs)
  83. end;
  84.  
  85. {- Enable menu commands }
  86. procedure GFileWindow.EnableCommand(commandID: Integer);
  87. begin
  88.   EnableMenuItem(Attr.Menu, commandID, mf_ByCommand or mf_Enabled)
  89. end;
  90.  
  91. {- Disable menu commands }
  92. procedure GFileWindow.DisableCommand(commandID: Integer);
  93. begin
  94.   EnableMenuItem(Attr.Menu, commandID, mf_ByCommand or mf_Grayed)
  95. end;
  96.  
  97. {- Display error message dialog }
  98. procedure GFileWindow.Error(S: String);
  99. var
  100.   P: array[0 .. 255] of Char;
  101. begin
  102.   MessageBox(HWindow, StrPCopy(P, S), 'Error!', mb_IconExclamation)
  103. end;
  104.  
  105. {- Return true if application can safely end }
  106. function GFileWindow.CanClose: Boolean;
  107. var
  108.   Answer: Integer;
  109. begin
  110.   CanClose := true;
  111.   if FileIsChanged then
  112.   begin
  113.     Answer := MessageBox(HWindow, 'Save changes before quitting?',
  114.     'Please answer', mb_YesNoCancel or mb_IconQuestion);
  115.     if Answer = idYes then
  116.       CanClose := SaveFile
  117.     else if Answer = idCancel then
  118.       CanClose := false
  119.   end
  120. end;
  121.  
  122. {- Perform file open and return true if successful }
  123. function GFileWindow.OpenFile: Boolean;
  124. var
  125.   F: File;
  126. begin
  127.   Assign(F, StrPas(FileName));
  128.   {$I-} Reset(F); {$I+}
  129.   if IoResult <> 0 then
  130.     Error('File ' + StrPas(FileName) + ' not found')
  131.   else begin
  132.     { Read file information into memory here }
  133.     Close(F);                { Note: File does NOT remain open }
  134.     FileIsOpen := true;      { i.e. file information is in memory }
  135.     FileIsChanged := false   { No changes made to file as of yet }
  136.   end;
  137.   OpenFile := FileIsOpen     { Return result to caller }
  138. end;
  139.  
  140. {- Perform file save and return true if successful }
  141. {  Note: Simulated; no data is written to disk }
  142. function GFileWindow.SaveFile: Boolean;
  143. var
  144.   Answer: Integer;
  145. begin
  146.   { Write in-memory data to FileName here }
  147.   Answer := MessageBox(HWindow, 'Save file successfully?',
  148.     'Simulated Operation', mb_YesNo);
  149.   if Answer = idYes then
  150.   begin
  151.     SaveFile := true;
  152.     FileIsChanged := false;
  153.   end else
  154.   begin
  155.     SaveFile := false;
  156.     Error('File ' + StrPas(FileName) + ' not saved')
  157.   end
  158. end;
  159.  
  160. { Menu commands }
  161.  
  162. {- File:Open }
  163. procedure GFileWindow.FileOpen(var Msg: TMessage);
  164. begin
  165.   StrCopy(FileName, '*.*');
  166.   if Application^.ExecDialog(New(PFileDialog, Init(@Self,
  167.     PChar(sd_FileOpen), FileName))) = id_Ok then
  168.   if OpenFile then
  169.   begin
  170.     SetWindowText(HWindow, FileName);
  171.     DisableAll;
  172.     EnableCommand(cm_FileClose);
  173.     EnableCommand(cm_FileSaveAs)
  174.   end
  175. end;
  176.  
  177. {- File:Close }
  178. procedure GFileWindow.FileClose(var Msg: TMessage);
  179. var
  180.   OkToClose: Boolean;
  181.   Answer: Integer;
  182. begin
  183.   OkToClose := true;
  184.   if FileIsChanged then
  185.   begin
  186.     Answer := MessageBox(HWindow, 'Save changes before closing?',
  187.     'Please answer', mb_YesNoCancel or mb_IconQuestion);
  188.     if Answer = idYes then
  189.       OkToClose := SaveFile
  190.     else if Answer = idCancel then
  191.       OkToClose := false
  192.   end;
  193.   if OkToClose then
  194.   begin
  195.     FileIsOpen := false;
  196.     FileIsChanged := false;
  197.     SetWindowText(HWindow, noFileStr);
  198.     DisableAll;
  199.     EnableCommand(cm_FileOpen);
  200.   end
  201. end;
  202.  
  203. {- File:Save }
  204. procedure GFileWindow.FileSave(var Msg: TMessage);
  205. begin
  206.   if SaveFile then
  207.     DisableCommand(cm_FileSave)
  208. end;
  209.  
  210. {- File:SaveAs }
  211. procedure GFileWindow.FileSaveAs(var Msg: TMessage);
  212. begin
  213.   if Application^.ExecDialog(New(PFileDialog, Init(@Self,
  214.     PChar(sd_FileSave), FileName))) = id_Ok then
  215.   if SaveFile then
  216.   begin
  217.     SetWindowText(HWindow, FileName);
  218.     DisableCommand(cm_FileSave)
  219.   end
  220. end;
  221.  
  222. {- File:Exit }
  223. procedure GFileWindow.FileExit(var Msg: TMessage);
  224. begin
  225.   CloseWindow
  226. end;
  227.  
  228. {- Simulate file edit--Click left mouse button }
  229. procedure GFileWindow.WMLButtonDown(var Msg: TMessage);
  230. begin
  231.   if FileIsOpen then
  232.   begin
  233.     FileIsChanged := true;
  234.     EnableCommand(cm_FileSave);
  235.     MessageBox(HWindow, 'File Change Simulated',
  236.       'Simulated Operation', mb_Ok);
  237.   end
  238. end;
  239.  
  240. var
  241.  
  242.   GFileApp: GFileApplication;
  243.  
  244. begin
  245.   GFileApp.Init('GFileApp');
  246.   GFileApp.Run;
  247.   GFileApp.Done
  248. end.
  249.  
  250.  
  251. {--------------------------------------------------------------
  252.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  253.   Revision 1.00    Date: 3/19/1991
  254. ---------------------------------------------------------------}
  255.